home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / misc / math / TCalcStats2c.lha / TCalcStats2c / AREXX / Descriptive_Stats.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1998-08-02  |  12.4 KB  |  623 lines
  1. /* Descriptive Statistics */
  2.  
  3. options results
  4. if ~show('P','TCALC') then do
  5.     address command 'run turbocalc:turbocalc'
  6.     address command 'waitforport TCALC'
  7.     loadflag=1
  8. end
  9. address 'TCALC'
  10. 'DEFPUBSCREEN()'
  11. /* Add-in Rexx Math Library needed for some routines */
  12. signal on syntax
  13. if ~show('l','rexxmathlib.library') then
  14.    call addlib('rexxmathlib.library',0,-30)
  15. if ~show('l','rexxreqtools.library') then
  16.    call addlib('rexxreqtools.library',0,-30)
  17. if ~show('l','rexxsupport.library') then
  18.    call addlib('rexxsupport.library',0,-30)
  19.   /* add to library list */
  20. signal off syntax
  21.  
  22. /* Start Main Routine */
  23. if loadflag=1 then 'Load()'
  24. 'ActivateWindow()'
  25. range=rtgetstring(,"Enter Cell Range for Input","Input Request",,) /* 'rt_pubscrname="TCALC"' */
  26. colon=pos(":",range)
  27. if colon=0 then do
  28.     'Message "Please select a range before executing this script"'
  29.     'DEFPUBSCREEN "Workbench"'
  30.     exit
  31. end
  32.  
  33. /* Find cell references and cell, column numbers */
  34. start_cell=substr(range,1,colon-1)
  35. end_cell=substr(range,colon+1)
  36. start_row=cellrow(start_cell)
  37. end_row=cellrow(end_cell)
  38. start_col=cellcol(start_cell)
  39. end_col=cellcol(end_cell)
  40. NRows=end_row-start_row+1
  41. NCols=end_col-start_col+1
  42.  
  43. /* Get cell reference for output range */
  44. out_cell=rtgetstring(,"Enter Cell Reference for Output","Input Request",,) /* 'rt_pubscrname="TCALC"' */
  45. if out_cell="" then do
  46.     'DEFPUBSCREEN("Workbench")'
  47.     exit
  48. end
  49. if length(out_cell)<2 | datatype(left(out_cell,1),'n')=1 then do
  50.     'Message "Invalid cell reference"'
  51.     'DEFPUBSCREEN "Workbench"'
  52.     exit
  53. end
  54. /* Suppress Screen Redraw to Speed Things Up */
  55. 'Refresh 0'
  56.  
  57. /* Open a small output window on tcalc screen*/
  58. fo=0
  59. CR='0a'x
  60. DisplayMsg="Calculating...Please Wait."||CR||"User input is disabled during calculation."||CR
  61. if open(6Info, 'con:100/0/450/80/Progress/SCREEN TCALC', w) then do
  62.      call writeln(6Info, DisplayMsg)
  63.     fo=1
  64. end
  65. else do
  66.     'Message "TCALC Screen not available for Progress messages"'
  67. end
  68. CALL DELAY(150)
  69.  
  70. /* Get cell references for top cell in each column */
  71. 'SelectCell' start_cell
  72. do col=start_col to end_col
  73.     'GetCursorPos'
  74.     top_cell.col=result
  75.     'Column 1'
  76. end
  77.  
  78. /* Get labels for later use on output */
  79. 'SelectCell' start_cell
  80. 'GetValue'
  81. testlabel=result
  82. testlabel=strip(testlabel)
  83. if datatype(testlabel,'n')=1 then do
  84.     labelflag=0
  85.     do x=1 to NCols
  86.     title.x="Column "||x
  87.     end
  88. end
  89. else do
  90.     labelflag=1
  91.     NRows=NRows-1
  92.     do x=1 to NCols
  93.     'GetValue'
  94.     str=result
  95.     title.x=translate(strip(str),"_"," ")
  96.     'Column 1'
  97.     end
  98. end
  99. if fo then call writech(6Info,"Progress...10 ")
  100. /* Get data from cell range */
  101. col=start_col
  102. lav=0
  103. tot=0
  104. count.=0
  105. total.=0
  106. do x=1 to NCols
  107.     'SelectCell' top_cell.col
  108.     if labelflag=1 then 'CursorDown 1'
  109.     do y=1 to NRows
  110.         'GetValue'
  111.         valtest=result
  112.         if datatype(valtest)='NUM' then do
  113.             'GetValue'
  114.             val=result
  115.             data.x.y=val
  116.             tot=tot+val
  117.             total.x=tot
  118.             count.x=1+count.x
  119.         end
  120.         'CursorDown 1'
  121.     end
  122.     col=col+1
  123.     tot=0
  124.     lav=0
  125.     val=0
  126. end
  127. if fo then call writech(6Info,"20 ")
  128.  
  129. /* Calculate Means */
  130. mean.=0
  131. do x=1 to NCols
  132.     mean.x=total.x/count.x
  133. end
  134.  
  135. /* Sort Values */
  136. call Sort()
  137.  
  138. /* Calculate Minimum, Maximum and Range */
  139. min.=0
  140. max.=0
  141. valrange.=0
  142. do z=1 to NCols
  143.     N=count.z
  144.     min.z=data.z.1
  145.     max.z=data.z.N
  146.     val=max.z-min.z
  147.     valrange.z=val
  148. end
  149. if fo then call writech(6Info,"30 ")
  150.  
  151. /* Calculate Median
  152. median.=0
  153. item=0
  154. do x=1 to NCols
  155.     mod=(count.x)//2
  156.     if mod ~=0 then do
  157.         item=((count.x)%2)+1
  158.         median.x=data.x.item
  159.     end
  160.     else do
  161.         item1=(count.x)%2
  162.         item2=item1+1
  163.         median.x=((data.x.item1)+(data.x.item2))/2
  164.     end
  165. end
  166. */
  167. /* Calculate quantiles */
  168. median.=0
  169. QA1.=0
  170. QA3.=0
  171. q1=0
  172. Do x=1 to NCols
  173.     mod=count.x//2
  174.     IF mod=0 then DO
  175.         n1=count.x/2
  176.         n2=n1+1
  177.         median.x=(data.x.n1+data.x.n2)/2
  178.         q1=INT(n1/2)+1
  179.         QA1.x=data.x.q1
  180.         q3=n1+q1
  181.         QA3.x=data.x.q3
  182.     END
  183.     ELSE DO
  184.         n3=INT(count.x/2)+1
  185.         median.x=data.x.n3
  186.         q1=INT(n3/2)
  187.         q1=q1+0
  188.         q2=q1+1
  189.         QA1.x=((data.x.q1)+(data.x.q2))/2
  190.         q3=n3+q1
  191.         q4=q3+1
  192.         QA3.x=((data.x.q3)+(data.x.q4))/2
  193.     END
  194. END    
  195. if fo then call writech(6Info,"40 ")
  196.  
  197. /* Calculate Mode */
  198. flag.=0
  199. z=0
  200. /* First create parallel set of data */
  201. cnt.=0
  202. do x=1 to NCols
  203.     t=1
  204.     temp.x.1=data.x.1
  205.     cnt.x=1
  206.     do y=2 to count.x
  207.         z=y-1
  208.         if (data.x.y)~=(data.x.z) then do    
  209.             cnt.x=1+cnt.x
  210.             t=t+1
  211.             temp.x.t=data.x.y
  212.         end
  213.     end
  214. end
  215. z=0
  216. maxnum.=0 /* array to hold an index of the numbers that are repeated */
  217. modecount.=0
  218. do x=1 to NCols
  219.     do i=1 to cnt.x
  220.         do y=1 to count.x
  221.             if temp.x.i=data.x.y then maxnum.x.i=1+maxnum.x.i
  222.         end
  223.     if (maxnum.x.i)>1 then modecount.x=1+modecount.x
  224.     end
  225. end
  226. mode.=0 /* mode array */
  227. do x=1 to NCols
  228. select
  229.      when modecount.x=1 then do
  230.         dummy1=0
  231.         dummy2=0
  232.         dump1=0
  233.         dump2=0
  234.         do y=1 to count.x
  235.             dummy1=data.x.y
  236.             dummy2=maxnum.x.y
  237.             z=y+1
  238.             if z<=count.x & dummy2>maxnum.x.z then do
  239.                 dump1=data.x.z
  240.                 dump2=maxnum.x.z
  241.                 data.x.z=dummy1
  242.                 maxnum.x.z=dummy2
  243.                 data.x.y=dump1
  244.                 maxnum.x.y=dump2
  245.             end
  246.             z=0
  247.         end
  248.         NR=count.x
  249.         mode.x=data.x.NR
  250.         end
  251.     when modecount.x=0 then 
  252.         mode.x="None"
  253.     otherwise 
  254.         mode.x="Multi_(See_Below)"
  255. end
  256. end
  257. if fo then call writech(6Info,"50 ")
  258.  
  259. /* Calculate Standard deviation and Variance */
  260. dat=0
  261. meenx=0
  262. sum.=0 /* Array holding sum of x minus mean of x squared */
  263. sum3.=0 /* Array holding sum of x minus mean of x to the 3rd power */
  264. sum4.=0 /* Array holdong sum of x minus mean of x to the 4th power */
  265. sd.=0 /* Standard deviation array */
  266. var.=0 /* Variance array */
  267. m2.=0
  268. m3.=0
  269. m4.=0
  270. do x=1 to NCols
  271.     sum.x=0
  272.     sum3.x=0
  273.     sum4.x=0
  274.     meenx=mean.x
  275.     do y =1 to count.x
  276.     dat=data.x.y
  277.     sum.x=(dat-meenx)**2+(sum.x)
  278.     sum3.x=(dat-meenx)**3+(sum3.x)
  279.     sum4.x=(dat-meenx)**4+(sum4.x)
  280.     end
  281.     N=(count.x)-1
  282.     var.x=(sum.x)/N
  283.     sd.x=sqrt(var.x)
  284.     m2.x=(sum.x)/(count.x) /* 2nd moment about the mean */
  285.     m3.x=(sum3.x)/(count.x) /* 3rd moment about the mean */
  286.     m4.x=(sum4.x)/(count.x) /* 4th moment about the mean */
  287. end
  288. if fo then call writech(6Info,"60 ")
  289.  
  290. /* Calculate standard error of the mean */
  291. serr.=0 /* Standard error array */
  292. do x=1 to NCols
  293.     val=sqrt(count.x)
  294.     serr.x=(sd.x)/(val)
  295. end
  296. if fo then call writech(6Info,"70 ")
  297.  
  298. /* Calculate Skewness and Kurtosis */
  299. sk.=0 /* Skewness array */
  300. ku.=0 /* Kurtosis array */
  301. mval=0
  302. do x=1 to NCols
  303.     mval=(m2.x)*sqrt(m2.x)
  304.     sk.x=(m3.x)/mval
  305.     ku.x=(m4.x)/((m2.x)**2)-3
  306. end
  307. if fo then call writech(6Info,"80 ")
  308.  
  309. /* Calculate Confidence Levels */
  310. clow.=0 /* low 95% confidence level array */
  311. cup.=0 /* high 95% confidence level array */
  312. clow2.=0 /* low 99% confidence level array */
  313. cup2.=0 /* high 99% confidence level array */
  314. do x=1 to NCols
  315.     clow.x=(mean.x)-(1.96*serr.x)
  316.     cup.x=(mean.x)+(1.96*serr.x)
  317.     clow2.x=(mean.x)-(2.58*serr.x)
  318.     cup2.x=(mean.x)+(2.58*serr.x)
  319. end
  320. if fo then call writech(6Info,"90 ")
  321.  
  322. /* Calculate Geometric mean, Harmonic mean, Root Mean Square, Mean Deviation */
  323. calcrms.=0
  324. calcg.=0
  325. calch.=0
  326. logg.=0
  327. G.=0
  328. H.=0
  329. RMS.=0
  330. calcmd.=0
  331. MD.=0
  332. Do x=1 to NCols
  333.     Do y=1 to count.x
  334.         calcg.x=(calcg.x)+(log10(data.x.y))
  335.         calch.x=(calch.x)+(1/data.x.y)
  336.         calcrms.x=(calcrms.x)+(data.x.y)**2
  337.         calcmd.x=(calcmd.x)+abs((data.x.y)-(mean.x))
  338.     end
  339.     logg.x=(calcg.x)/(count.x)
  340.     'SelectCell' out_cell
  341.     'Put' logg.x
  342.     'CursorDown 1'
  343.     'Put "=POW10(Cell(-1;0))"'
  344.     'GetValue'
  345.     G.x=result
  346.     G.x=trunc(G.x,4)
  347.     H.x=(count.x)/(calch.x)
  348.     RMS.x=SQRT((calcrms.x)/(count.x))
  349.     MD.x=(calcmd.x)/(count.x)
  350.     calcmd.x=(calcmd.x)/(count.x)
  351. end
  352. if fo then do
  353.     call writeln(6Info,"100 ")
  354.     call writeln(6Info,"Writing output to window...")
  355. end
  356. /* Output */
  357. 'SelectCell' out_cell
  358. 'ColumnWidth 25'
  359. 'Put' "Statistics"
  360. 'Column 1'
  361. do x=1 to NCols
  362.     'GetCursorPos'
  363.     first_cell.x=result
  364.     'Column 1'
  365. end
  366. 'SelectCell' out_cell
  367. 'CursorDown 1'
  368. 'Put' "Count:"
  369. 'CursorDown 1'
  370. 'Put' "Sum:"
  371. 'CursorDown 1'
  372. 'Put' "Mean(Arith.):"
  373. 'CursorDown 1'
  374. 'Put' "Mean(Geo.):"
  375. 'CursorDown 1'
  376. 'Put' "Mean(Harm.):"
  377. 'CursorDown 1'
  378. 'Put' "Mean(Quad.):"
  379. 'CursorDown 1'
  380. 'Put' "Mode:"
  381. 'CursorDown 1'
  382. 'Put "First Quartile:"'
  383. 'CursorDown 1'
  384. 'Put' "Median:"
  385. 'CursorDown 1'
  386. 'Put "Third Quartile:"'
  387. 'CursorDown 1'
  388. 'Put' "Range:"
  389. 'CursorDown 1'
  390. 'Put' "Maximum:"
  391. 'CursorDown 1'
  392. 'Put' "Minimum:"
  393. 'CursorDown 1'
  394. 'Put "Std. Error:"'
  395. 'CursorDown 1'
  396. 'Put "Std. Deviation:"'
  397. 'CursorDown 1'
  398. 'Put "Mean Deviation:"'
  399. 'CursorDown 1'
  400. 'Put' "Variance:"
  401. 'CursorDown 1'
  402. 'Put' "Skewness:"
  403. 'CursorDown 1'
  404. 'Put' "Kurtosis:"
  405. 'CursorDown 1'
  406. 'Put "Confidence Level (95%)-low:"'
  407. 'CursorDown 1'
  408. 'Put "Confidence Level (95%)-high:"'
  409. 'CursorDown 1'
  410. 'Put "Confidence Level (99%)-low:"'
  411. 'CursorDown 1'
  412. 'Put "Confidence Level (99%)-high:"'
  413. do x=1 to NCols
  414.     'SelectCell' first_cell.x
  415.     j=x-1
  416.     if (x>1) & (modecount.j>1) then 'Column 1'
  417.     'ColumnWidth' 10
  418.     title=""""||title.x||""""
  419.     'Alignment 2'
  420.     'Put' title
  421.     'CursorDown 1'
  422.     'Put' count.x
  423.     'CursorDown 1'
  424.     'Put' total.x
  425.     'CursorDown 1'
  426.     'Put' format(mean.x,,4)
  427.     'CursorDown 1'
  428.     'Put' format(G.x,,4)
  429.     'CursorDown 1'
  430.     'Put' format(H.x,,4)
  431.     'CursorDown 1'
  432.     'Put' format(RMS.x,,4)
  433.     'CursorDown 1'
  434.     'Put' mode.x
  435.     'CursorDown 1'
  436.     'Put' QA1.x
  437.     'CursorDown 1'
  438.     'Put' median.x
  439.     'CursorDown 1'
  440.     'Put' QA3.x
  441.     'CursorDown 1'
  442.     'Put' valrange.x
  443.     'CursorDown 1'
  444.     'Put' max.x
  445.     'CursorDown 1'
  446.     'Put' min.x
  447.     'CursorDown 1'
  448.     'Put' format(serr.x,,4)
  449.     'CursorDown 1'
  450.     'Put' format(sd.x,,4)
  451.     'CursorDown 1'
  452.     'Put' format(MD.x,,4)
  453.     'CursorDown 1'
  454.     'Put' format(var.x,,4)
  455.     'CursorDown 1'
  456.     'Put' format(sk.x,,4)
  457.     'CursorDown 1'
  458.     'Put' format(ku.x,,4)
  459.     'CursorDown 1'
  460.     'Put' format(clow.x,,4)
  461.     'CursorDown 1'
  462.     'Put' format(cup.x,,4)
  463.     'CursorDown 1'
  464.     'Put' format(clow2.x,,4)
  465.     'CursorDown 1'
  466.     'Put' format(cup2.x,,4)
  467.     if modecount.x>1 then do
  468.         'CursorDown 1'
  469.         'Alignment 2'
  470.         'Put "Mode"'
  471.         'Column 1'
  472.         'Alignment 2'
  473.         'ColumnWidth 7'
  474.         'Put "Count"'
  475.         'Column -1'
  476.         'CursorDown 1'
  477.         do i=1 to cnt.x
  478.         if maxnum.x.i>1 then do
  479.             'Put' temp.x.i
  480.             'Column 1'
  481.             'Put' maxnum.x.i
  482.             'Column -1'
  483.             'CursorDown 1'
  484.             end
  485.         end
  486.     end
  487. end
  488.  
  489. 'Refresh 1'
  490. 'Refresh 2'
  491. /*'Message' "Finished"*/
  492. /*indicate the main script is finished*/
  493. DisplayMsg="Cleaning up ...."||CR||"Exiting"
  494. result=writeln(6Info, DisplayMsg)
  495. if result~=0 then do
  496.     /*Wait 3 seconds*/
  497.     CALL DELAY(150)
  498.     /* close window*/
  499.     result=close(6Info)
  500. end
  501. 'DEFPUBSCREEN("Workbench")'
  502. exit
  503.  
  504. /* Procedures */
  505.  
  506. cellrow: procedure
  507. do
  508.     parse arg cell
  509.     do charpos=2 to length(cell)
  510.     if datatype(substr(cell,charpos,1),n) then return substr(cell,charpos)
  511.     end
  512.     return 0
  513. end
  514. Return
  515.  
  516. cellcol: procedure
  517. do
  518.     parse arg cell
  519.     labels="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  520.     cell=upper(cell)
  521.     len=length(cell)
  522.     val=0
  523. do charpos=1 to len
  524.     if datatype(substr(cell,charpos,1),n) then
  525.     do cell=reverse(substr(cell,1,charpos-1))
  526.     do x=1 to length(cell)
  527.     val=(26**(x-1))*pos(substr(cell,x,1),labels)+val
  528.     end
  529.     return val
  530.     end
  531.     end
  532.     return 0
  533. end
  534. Return
  535. /* It is important to put the exposed array at the end of the next line */
  536. Sort: procedure expose NCols count. data.
  537. do x=1 to NCols
  538. L=(xtoy(2,int(log(count.x)/log(2))))-1
  539.     Do Until L<1
  540.     L=trunc(int(L/2))
  541.     Do J=1 to L
  542.             Do K=J+L To count.x By L
  543.             I=K
  544.             dumdat=data.x.I
  545.             Do while I>L
  546.                 y=I-L
  547.                 If data.x.y ~> dumdat then Leave
  548.                 data.x.I=data.x.y
  549.                 I=I-L
  550.             End
  551.             data.x.I=dumdat
  552.             End
  553.         End
  554.     End
  555. End
  556. Return
  557.  
  558. syntax:
  559.      if arg(1)='FAIL' then do
  560.         'Message "Library is unavailable."'
  561.         'DEFPUBSCREEN "Workbench"'
  562.         exit
  563.         end
  564.     'DEFPUBSCREEN("Workbench")'
  565.     exit
  566.  
  567. Format:  procedure
  568.  
  569.      arg number, before, after
  570.      CallLine = SIGL
  571.      if ~datatype(CallLine, 'N') then CallLine = '??'
  572.  
  573.      /* Make sure we have a number as first (required) argument    */
  574.      if ~datatype(number, 'N') then do
  575.         if number = '' then
  576.            fc = 17     /* Wrong number of arguments           */
  577.         else
  578.            fc = 47     /* Arithmetic conversion error             */
  579.         signal FormatSyntaxError
  580.      end
  581.      num = number + 0
  582.      if before = '' & after = '' then
  583.         return num
  584.      else do
  585.         parse var num integer '.' fraction
  586.         if before = '' then before = length(integer)
  587.         if after = '' then after = length(fraction)
  588.         if ~datatype(before, N) | ~datatype(after, N) then
  589.            do fc = 18
  590.            signal FormatSyntaxError
  591.        end
  592.         if before < length(integer) then do
  593.            fc = 18
  594.            signal FormatSyntaxError
  595.         end
  596.         if after ~= length(fraction) then do
  597.            fraction = trunc(('.'fraction'0') + ('.'copies('0', after)'5'), after)
  598.         if integer<1&integer>-1 then integer=integer
  599.            else integer = integer + (fraction % 1)
  600.            fraction = substr(fraction, 3)
  601.         end
  602.         if fraction >= 0 then
  603.            return right(integer, before)'.'fraction
  604.         else
  605.            return right(integer, before)
  606.      end
  607.  
  608.  FormatSyntaxError:
  609.         if show('F', STDERR) then
  610.            call writeln(STDERR, '+++ Error' fc 'in line' CallLine':' errortext(fc))
  611.         else
  612.            mess='+++ Error' fc 'in line' CallLine':' errortext(fc)
  613.         'Message' mess
  614.         parse source Func .
  615.         if Func = 'FUNCTION' then do
  616.         'DEFPUBSCREEN("Workbench")'
  617.            exit "Err"
  618.         end
  619.         else do
  620.         'DEFPUBSCREEN("Workbench")'
  621.            exit 10
  622.         end
  623.